home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
bipl.zip
/
PROGS.ZIP
/
MR.ICN
< prev
next >
Wrap
Text File
|
1993-01-27
|
12KB
|
424 lines
############################################################################
#
# File: mr.icn
#
# Subject: Program to read mail
#
# Author: Ronald Florence
#
# Date: April 29, 1992
#
###########################################################################
#
# Version: 1.4
#
###########################################################################
#
# With no arguments, mr reads the default mail spool. Another user,
# a spool file, or the recipient for outgoing mail can be given as
# a command line argument. Help, including the symbols used to
# indicate the status of mail, is available with the H command.
#
# Usage: mr [recipient] [-u user] [-f spool]
#
# Configuration:
#
# Editor for replies or new mail.
# Host optional upstream routing address for outgoing mail;
# a domained Host is appended to the address, a uucp
# Host prefixes the address.
# Mail_cmd the system mailer (usually sendmail, smail, or mail).
# print_cmd command to format and/or spool material for the printer
# (for OS with pipes). &null for ms-dos.
# ignore a list of headers to hide when paging messages. The V
# command views hidden headers.
#
# Non-UNIX systems only:
#
# non_unix_mailspool full path of the default mailspool.
#
############################################################################
#
# Links: iolib, options, tempname
link iolib, options, tempname
global Host, Editor, Spool, Status, Mail_cmd
procedure main(arg)
local i, opts, cmd, art, mailspool, print_cmd, ignore, non_unix_mailspool
# configuration
Editor := "vi"
Host := &null
Mail_cmd := "/usr/lib/sendmail -t"
print_cmd := "mp -F | lpr"
ignore := ["From ", "Message-Id", "Received", "Return-path", "\tid",
"Path", "Xref", "References", "X-mailer", "Errors-to",
"Resent-Message-Id", "Status", "X-lines", "X-VM-Attributes"]
non_unix_mailspool := &null
# end of configuration
if not "UNIX" == &features then
mailspool := getenv("MAILSPOOL") | \non_unix_mailspool | "DUNNO"
opts := options(arg, "u:f:h?")
\opts["h"] | \opts["?"] | arg[1] == "?" &
stop("usage: mr [recipient] [-f spoolfile] [-u user]")
\arg[1] & { write(); newmail(arg[1]); exit(0) }
/mailspool := "/usr/spool/mail/" || (\opts["u"] | getenv("LOGNAME"|"USER"))
\opts["f"] & mailspool := opts["f"]
i := readin(mailspool)
headers(mailspool, i)
repeat {
cmd := query("\n[" || i || "/" || *Status || "]: ", " ")
if integer(cmd) & (cmd > 0) & (cmd <= *Status) then
headers(mailspool, i := cmd)
else case map(!cmd) of {
" ": { showart(i, ignore); i := inc(i) }
"a": save(query("Append to: "), i, "append")
"d": { Status[i] ++:= 'D'; clear_line(); i := inc(i) }
"f": forward(query("Forward to: "), i)
"g": readin(mailspool, "update") & headers(mailspool, i)
"l": headers(mailspool, i)
"m": newmail(query("Address: "))
"p": print(print_cmd, i)
"q": quit(mailspool)
"r": reply(i)
"s": save(query("Filename: "), i)
"u": { Status[i] --:= 'D'; clear_line(); i := inc(i) }
"v": showart(i, ignore, "all")
"x": upto('yY', query("Are you sure? ")) & exit(1)
"|": pipeto(query("Command: "), i)
"!": { system(query("Command: "))
write() & query("Press <return> to continue") }
"-": { if (i -:= 1) = 0 then i := *Status; showart(i, ignore) }
"+"|"n": showart(i := inc(i), ignore)
"?"|"h": help()
default: clear_line() & writes("\^g")
}
}
end
# Read the mail spool into a list of
# lists and set up a status list.
procedure readin(spoolname, update)
local sf, i, article
Spool := []
\update | Status := []
sf := open(spoolname) | stop("Can't read " || spoolname)
i := 0
every !sf ? {
="From " & {
((i +:= 1) > 1) & put(Spool, article)
article := []
(i > *Status) & put(Status, 'N')
}
(i > 0) & put(article, &subject)
}
(i > 0) & {
put(Spool, article)
i := 1
}
close(sf)
return i
end
# Parse messages for author & subject,
# highlight the current message.
procedure headers(spoolname, art)
local hlist, i, entry, author, subj
hlist := []
every i := 1 to *Status do {
entry := if i = art then getval("md"|"so") else ""
entry ||:= left(i, 3, " ") || left(Status[i], 4, " ")
author := ""
subj := ""
while (*author = 0) | (*subj = 0) do !Spool[i] ? {
="From: " & author := tab(0)
="Subject: " & subj := tab(0)
(*&subject = 0) & break
}
entry ||:= " [" || right(*Spool[i], 3, " ") || ":"
entry ||:= left(author, 17, " ") || "] " || left(subj, 45, " ")
(i = art) & entry ||:= getval("me"|"se")
put(hlist, entry)
}
put(hlist, "")
more(spoolname, hlist)
end
# Check if any messages are deleted;
# if the spool cannot be written,
# write a temporary spool. Rename
# would be convenient, but won't work
# across file systems.
procedure quit(spoolname)
local msave, f, tfn, i
every !Status ? { find("D") & break msave := 1 }
\msave & {
readin(spoolname, "update")
(f := open(spoolname, "w")) | {
f := open(tfn := tempname(), "w")
write("Cannot write " || spoolname || ". Saving changes to " || tfn)
}
every i := 1 to *Status do {
find("D", Status[i]) | every write(f, !Spool[i])
}
}
exit(0)
end
procedure save(where, art, append)
local mode, outf
mode := if \append then "a" else "w"
outf := open(where, mode) | { write("Can't write ", where) & fail }
every write(outf, !Spool[art])
Status[art] ++:= 'S'
return close(outf)
end
procedure pipeto(cmd, art)
static real_pipes
local p, tfn, status
initial real_pipes := "pipes" == &features
p := (\real_pipes & open(cmd, "wp")) | open(tfn := tempname(), "w")
every write(p, !Spool[art])
if \real_pipes then return close(p)
else {
cmd ||:= " < " || tfn
status := system(cmd)
remove(tfn)
return status
}
end
procedure print(cmd, art)
local p, status
if \cmd then status := pipeto(cmd, art)
else if not "MS-DOS" == &features then
return write("Sorry, not configured to print messages.")
else {
p := open("PRN", "w")
every write (p, !Spool[art])
status := close(p)
}
\status & { Status[art] ++:= 'P'; clear_line() }
end
# Lots of case-insensitive parsing.
procedure reply(art)
local tfn, fullname, address, quoter, date, id, subject, newsgroup, refs, r
r := open(tfn := tempname(), "w")
every !Spool[art] ? {
tab(match("from: " | "reply-to: ", map(&subject))) & {
if find("<") then {
fullname := tab(upto('<'))
address := (move(1), tab(find(">")))
}
else {
address := trim(tab(upto('(') | 0))
fullname := (move(1), tab(find(")")))
}
while match(" ", \fullname, *fullname) do fullname ?:= tab(-1)
quoter := if *\fullname > 0 then fullname else address
}
tab(match("date: ", map(&subject))) & date := tab(0)
tab(match("message-id: ", map(&subject))) & id := tab(0)
match("subject: ", map(&subject)) & subject := tab(0)
match("newsgroups: ", map(&subject)) & newsgroup := tab(upto(',') | 0)
match("references: ", map(&subject)) & refs := tab(0)
(\address & *&subject = 0) & {
writes(r, "To: " || address)
write(r, if *\fullname > 0 then " (" || fullname || ")" else "")
\subject & write(r, subject)
\newsgroup & write(r, newsgroup)
\refs & write(r, refs, " ", id)
write(r, "In-reply-to: ", quoter, "'s message of ", date);
write(r, "\nIn ", id, ", ", quoter, " writes:\n")
break
}
}
every write(r, " > ", !Spool[art])
send(tfn, address) & {
Status[art] ++:= 'RO'
Status[art] --:= 'N'
}
end
# Put user in an editor with a temp
# file, query for confirmation, if
# necessary rewrite address, and send.
procedure send(what, where)
local edstr, mailstr, done
static console
initial {
if "UNIX" == &features then console := "/dev/tty"
else if "MS-DOS" == &features then console := "CON"
else stop("Please configure `console' in mr.icn.")
}
edstr := (getenv("EDITOR") | Editor) || " " || what || " < " || console
system(edstr)
upto('nN', query( "Send to " || where || " y/n? ")) & {
if upto('yY', query("Save your draft y/n? ")) then
clear_line() & write("Your draft is saved in " || what || "\n")
else clear_line() & remove(what)
fail
}
clear_line()
\Host & not find(map(Host), map(where)) & upto('!@', where) & {
find("@", where) & where ? {
name := tab(upto('@'))
where := (move(1), tab(upto(' ') | 0)) || "!" || name
}
if find(".", Host) then where ||:= "@" || Host
else where := Host || "!" || where
}
mailstr := Mail_cmd || " " || where || " < " || what
done := system(mailstr)
remove(what)
return done
end
procedure forward(who, art)
local out, tfn
out := open(tfn := tempname(), "w")
write(out, "To: " || who)
write(out, "Subject: FYI (forwarded mail)\n")
write(out, "-----[begin forwarded message]-----")
every write(out, !Spool[art])
write(out, "------[end forwarded message]------")
send(tfn, who) & Status[art] ++:= 'F'
end
procedure newmail(address)
local out, tfn
out := open(tfn := tempname(), "w")
write(out, "To: " || address)
write(out, "Subject:\n")
return send(tfn, address)
end
procedure showart(art, noshow, eoh)
local out
out := []
every !Spool[art] ? {
/eoh := *&subject = 0
if \eoh | not match(map(!noshow), map(&subject)) then put(out, tab(0))
}
more("Message " || art, out, "End of Message " || art)
Status[art] ++:= 'O'
Status[art] --:= 'N'
end
procedure help()
local hlist, item
static pr, sts
initial {
pr := ["Append message to a file",
"Delete message",
"eXit, without saving changes",
"Forward message",
"Get new mail",
"Help",
"List headers",
"Mail to a new recipient",
"Next message",
"Print message",
"Quit, saving changes",
"Reply to message",
"Save message",
"Undelete message",
"View all headers",
"| pipe message to a command",
"+ next message",
"- previous message",
"! execute command",
"# make # current message",
" "]
sts := ["New", "Old", "Replied-to", "Saved",
"Deleted", "Forwarded", "Printed"]
}
hlist := []
every !(pr ||| sts) ? {
item := " "
item ||:= tab(upto(&ucase++'!|+-#') \1) || getval("md"|"so") ||
move(1) || getval("me"|"se") || tab(0)
put(hlist, item)
}
put(hlist, "")
more("Commands & Status Symbols", hlist)
end
# The second parameter specifies a
# default response if the user presses
# <return>.
procedure query(prompt, def)
local ans
clear_line()
writes(prompt)
ans := read()
return (*ans = 0 & \def) | ans
end
# Increment the count, then cycle
# through again when user reaches the
# end of the list.
procedure inc(art)
if (art +:= 1) > *Status then art := 1
return art
end
procedure more(header, what, footer)
local ans, lines
writes(getval("cl"))
lines := 0
\header & {
write(getval("us") || header || getval("ue"))
lines +:= 1
}
every !what ? {
write(tab(0))
((lines +:= 1 + *&subject/getval("co")) % (getval("li") - 1) = 0) & {
writes(getval("so") ||
"-MORE-(", (100 > (lines - 2)*100/*what) | 100, "%)" ||
getval("se"))
ans := read() & clear_line()
upto('nNqQ', ans) & fail
}
}
\footer & {
writes(getval("so") || footer || getval("se"))
read() & clear_line()
}
end
procedure clear_line()
return writes(getval("up") || getval("ce"))
end